home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / pcl / src-16f.lha / code / mach-os.lisp < prev    next >
Encoding:
Text File  |  1992-12-09  |  2.5 KB  |  78 lines
  1. ;;; -*- Package: SYSTEM -*-
  2. ;;;
  3. ;;; **********************************************************************
  4. ;;; This code was written as part of the CMU Common Lisp project at
  5. ;;; Carnegie Mellon University, and has been placed in the public domain.
  6. ;;; If you want to use this code or any part of CMU Common Lisp, please contact
  7. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
  8. ;;;
  9. (ext:file-comment
  10.   "$Header: mach-os.lisp,v 1.9 92/07/03 00:09:31 wlott Exp $")
  11. ;;;
  12. ;;; **********************************************************************
  13. ;;;
  14. ;;; OS interface functions for CMU CL under Mach.
  15. ;;;
  16. ;;; Written and maintained mostly by Skef Wholey and Rob MacLachlan.
  17. ;;; Scott Fahlman, Dan Aronson, and Steve Handerson did stuff here, too.
  18. ;;;
  19. (in-package "SYSTEM")
  20. (use-package "EXTENSIONS")
  21. (export '(get-system-info get-page-size os-init))
  22. (export '(*task-self* *task-data* *task-notify*))
  23.  
  24. (pushnew :mach *features*)
  25. (setq *software-type* "MACH/4.3BSD")
  26.  
  27. (defconstant foreign-segment-start #x00C00000)
  28. (defconstant foreign-segment-size  #x00400000)
  29.  
  30. (defun software-version ()
  31.   "Returns a string describing version of the supporting software."
  32.   (string-trim '(#\newline)
  33.            (with-output-to-string (stream)
  34.          (run-program "/usr/cs/etc/version" ; Site dependent???
  35.                   nil :output stream))))
  36.  
  37.  
  38. ;;; OS-Init initializes our operating-system interface.  It sets the values
  39. ;;; of the global port variables to what they should be and calls the functions
  40. ;;; that set up the argument blocks for the server interfaces.
  41.  
  42. (defvar *task-self*)
  43.  
  44. (defun os-init ()
  45.   (setf *task-self* (mach:mach-task_self)))
  46.  
  47.  
  48. ;;; GET-SYSTEM-INFO  --  Interface
  49. ;;;
  50. ;;;    Return system time, user time and number of page faults.  For
  51. ;;; page-faults, we add pagein and pageout, since that is a somewhat more
  52. ;;; interesting number than the total faults.
  53. ;;;
  54. (defun get-system-info ()
  55.   (multiple-value-bind (err? utime stime maxrss ixrss idrss
  56.                  isrss minflt majflt)
  57.                (unix:unix-getrusage unix:rusage_self)
  58.     (declare (ignore maxrss ixrss idrss isrss minflt majflt))
  59.     (unless err?
  60.       (error "Unix system call getrusage failed: ~A."
  61.          (unix:get-unix-error-msg utime)))
  62.     
  63.     (multiple-value-bind (gr ps fc ac ic wc zf ra in ot)
  64.              (mach:vm_statistics *task-self*)
  65.       (declare (ignore ps fc ac ic wc zf ra))
  66.       (mach:gr-error 'mach:vm_statistics gr)
  67.       
  68.       (values utime stime (+ in ot)))))
  69.  
  70.  
  71. ;;; GET-PAGE-SIZE  --  Interface
  72. ;;;
  73. ;;;    Return the system page size.
  74. ;;;
  75. (defun get-page-size ()
  76.   (mach:gr-call* mach:vm_statistics *task-self*))
  77.  
  78.